home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / s_to_z / tabutil / tabtest.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  8.4 KB  |  277 lines
  1. unit Tabtest;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Controls,
  7.   Forms, Dialogs, TabUtils, StdCtrls, DB, DBTables, Grids, DBGrids, Spin,
  8.   DBCtrls, TabNotBk, ShellAPI ;
  9.  
  10. type
  11.   TForm1 = class(TForm)
  12.     DataSource1: TDataSource;
  13.     Tabley: TTable;
  14.     Queryy: TQuery;
  15.     Notebook: TTabbedNotebook;
  16.     FieldNameNum: TSpinEdit;
  17.     Button1: TButton;
  18.     Button2: TButton;
  19.     Button3: TButton;
  20.     Label1: TLabel;
  21.     Label3: TLabel;
  22.     Button10: TButton;
  23.     Button11: TButton;
  24.     Button12: TButton;
  25.     Button6: TButton;
  26.     Button7: TButton;
  27.     Button9: TButton;
  28.     ExportTypeDD: TComboBox;
  29.     ExportPath: TEdit;
  30.     Button4: TButton;
  31.     Button5: TButton;
  32.     FieldsDD: TComboBox;
  33.     GroupSumLB: TListBox;
  34.     Label2: TLabel;
  35.     DBGrid1: TDBGrid;
  36.     Label4: TLabel;
  37.     Label6: TLabel;
  38.     Label7: TLabel;
  39.     Label5: TLabel;
  40.     Button13: TButton;
  41.     QueryySYMBOL: TStringField;
  42.     QueryyCO_NAME: TStringField;
  43.     QueryyEXCHANGE: TStringField;
  44.     QueryyCUR_PRICE: TFloatField;
  45.     QueryyYRL_HIGH: TFloatField;
  46.     QueryyYRL_LOW: TFloatField;
  47.     QueryyP_E_RATIO: TFloatField;
  48.     QueryyBETA: TFloatField;
  49.     QueryyPROJ_GRTH: TFloatField;
  50.     QueryyINDUSTRY: TSmallintField;
  51.     QueryyPRICE_CHG: TSmallintField;
  52.     QueryySAFETY: TSmallintField;
  53.     QueryyRATING: TStringField;
  54.     QueryyRANK: TFloatField;
  55.     QueryyOUTLOOK: TSmallintField;
  56.     QueryyRCMNDATION: TStringField;
  57.     QueryyRISK: TStringField;
  58.     Button8: TButton;
  59.     Button14: TButton;
  60.     procedure FormActivate(Sender: TObject);
  61.     procedure Button1Click(Sender: TObject);
  62.     procedure Button2Click(Sender: TObject);
  63.     procedure Button3Click(Sender: TObject);
  64.     procedure Button4Click(Sender: TObject);
  65.     procedure Button5Click(Sender: TObject);
  66.     procedure Button6Click(Sender: TObject);
  67.     procedure Button7Click(Sender: TObject);
  68.     procedure Button9Click(Sender: TObject);
  69.     procedure Button10Click(Sender: TObject);
  70.     procedure Button11Click(Sender: TObject);
  71.     procedure Button12Click(Sender: TObject);
  72.     procedure Button13Click(Sender: TObject);
  73.     procedure Button8Click(Sender: TObject);
  74.     procedure Button14Click(Sender: TObject);
  75.  
  76.   private
  77.     { Private declarations }
  78.   public
  79.     { Public declarations }
  80.   end;
  81.  
  82. var
  83.   Form1: TForm1;
  84.  
  85. implementation
  86.  
  87. {$R *.DFM}
  88.  
  89. procedure TForm1.Button1Click(Sender: TObject);
  90. begin
  91.      label1.Caption := 'The selected field is called ' + GetFieldName('DBDEMOS', 'MASTER.DBF', FieldNameNum.Value) ;
  92. end;
  93.  
  94. procedure TForm1.Button2Click(Sender: TObject);
  95. begin
  96.      If (FieldsDD.ItemIndex = 7) or (FieldsDD.ItemIndex = 8) then
  97.         MessageDlg('Cannot Perform Calculations on Text Fields', mtInformation, [mbOK], 0)
  98.      else begin
  99.         label2.Caption := 'Column Total for ' + FieldsDD.Text + ' = ' +
  100.            FloattoStr(ColumnTotal('DBDEMOS', 'MASTER.DBF', FieldsDD.Text)) ;
  101.      end ;
  102. end;
  103.  
  104. procedure TForm1.Button3Click(Sender: TObject);
  105. var
  106.    fldlist : TStringList ;
  107.    xx      : Integer ;
  108. begin
  109.      xx := 0 ;
  110.      Tabley.Active := False ;
  111.      Tabley.TableName := 'OUTPUT.DB' ;
  112.      DataSource1.DataSet := Tabley ;
  113.      fldlist := TStringList.Create ;
  114.      fldlist.Clear ;
  115.      While xx <> 10 do begin
  116.         If GroupSumLB.Selected[xx] = True then
  117.              fldlist.Add(GroupSumLB.Items.Strings[xx]) ;
  118.         Inc(xx) ;
  119.      end ;
  120.  
  121.      If GroupSummary('DBDEMOS', 'MASTER.DBF', 'OUTPUT.DB', FieldsDD.Text, fldlist) = 0 then
  122.         MessageDlg('Table created OK', mtInformation, [mbOK], 0)
  123.      else
  124.         MessageDlg('Table not created', mtWarning, [mbOK], 0) ;
  125.  
  126.      fldlist.Free ;
  127.      Tabley.Active := True ;
  128. end;
  129.  
  130. procedure TForm1.Button4Click(Sender: TObject);
  131. begin
  132.      Queryy.Active := False ;
  133.      DataSource1.DataSet := Queryy ;
  134.      Queryy.Active := True ;
  135.  
  136.      If (FieldsDD.ItemIndex = 7) or (FieldsDD.ItemIndex = 8) then
  137.         MessageDlg('Cannot Perform Calculations on Text Fields', mtInformation, [mbOK], 0)
  138.      else begin
  139.         label2.Caption := 'Column Total for ' + FieldsDD.Text + ' = ' +
  140.            FloattoStr(DS_ColumnTotal(Queryy, FieldsDD.Text)) ;
  141.      end ;
  142. end;
  143.  
  144. procedure TForm1.Button5Click(Sender: TObject);
  145. begin
  146.      Tabley.Active := False ;
  147.      Tabley.TableName := 'MASTER.DBF' ;
  148.      DataSource1.DataSet := Tabley ;
  149.      Tabley.Active := True ;
  150.  
  151.      If (FieldsDD.ItemIndex = 7) or (FieldsDD.ItemIndex = 8) then
  152.         MessageDlg('Cannot Perform Calculations on Text Fields', mtInformation, [mbOK], 0)
  153.      else begin
  154.         label2.Caption := 'Column Total for ' + FieldsDD.Text + ' = ' +
  155.            FloattoStr(DS_ColumnTotal(Tabley, FieldsDD.Text)) ;
  156.      end ;
  157. end;
  158.  
  159. procedure TForm1.Button6Click(Sender: TObject);
  160. var
  161.    fldlist : TStringList ;
  162.    xx      : Integer ;
  163.    exptype : TFFormat ;
  164. begin
  165.      xx := 0 ;
  166.      fldlist := TStringList.Create ;
  167.      fldlist.Clear ;
  168.      While xx <> 10 do begin
  169.         If GroupSumLB.Selected[xx] = True then
  170.              fldlist.Add(GroupSumLB.Items.Strings[xx]) ;
  171.         Inc(xx) ;
  172.      end ;
  173.      Tabley.Active := False ;
  174.      Tabley.TableName := 'OUTPUT.DB' ;
  175.      Tabley.Active := True ;
  176.      DataSource1.DataSet := Tabley ;
  177.      Tabley.Edit ;
  178.      Tabley.Delete ;
  179.  
  180.      case ExportTypeDD.ItemIndex of
  181.         0 : exptype := fftCSV ;
  182.         1 : exptype := fftFixed ;
  183.         2 : exptype := fftQuoted ;
  184.      end ;
  185.  
  186.      If DS_ExportToTxt(Tabley, ExportPath.Text, fftCSV, True) then begin
  187.         MessageDlg('File Created OK', mtInformation, [mbOK], 0) ;
  188.         DataSource1.DataSet.Active := True ;
  189.         end
  190.      else
  191.         MessageDlg('File Not Created ', mtWarning, [mbOK], 0) ;
  192.  
  193.      fldlist.Free ;
  194. end;
  195.  
  196. procedure TForm1.Button7Click(Sender: TObject);
  197. var
  198.    exptype : TFFormat ;
  199. begin
  200.      case ExportTypeDD.ItemIndex of
  201.         0 : exptype := fftCSV ;
  202.         1 : exptype := fftFixed ;
  203.         2 : exptype := fftQuoted ;
  204.      end ;
  205.  
  206.      If ExportToTxt('DBDEMOS', 'MASTER.DBF', Exportpath.Text, exptype, True) then
  207.         MessageDlg('File created OK', mtInformation, [mbOK], 0)
  208.      else
  209.         MessageDlg('File not created ', mtWarning, [mbOK], 0) ;
  210. end;
  211.  
  212. procedure TForm1.Button9Click(Sender: TObject);
  213. begin
  214.      If AppendFromCSV('DBDEMOS', 'FROMCSV.DB', 'FROMCSV.TXT') then
  215.         MessageDlg('Table updated OK', mtInformation, [mbOK], 0)
  216.      else
  217.         MessageDlg('Table not updated ', mtWarning, [mbOK], 0) ;
  218. end;
  219.  
  220. procedure TForm1.Button10Click(Sender: TObject);
  221. begin
  222.      If (FieldsDD.ItemIndex = 7) or (FieldsDD.ItemIndex = 8) then
  223.         MessageDlg('Cannot Perform Statistical Functions on Text Fields', mtInformation, [mbOK], 0)
  224.      else
  225.         label3.Caption := 'Minimum Value in ' + FieldsDD.Text + ' field is ' +
  226.            FloattoStr(ColumnStatVal(sfMIN, 'DBDEMOS', 'MASTER.DBF', FieldsDD.Text)) ;
  227. end;
  228.  
  229. procedure TForm1.Button11Click(Sender: TObject);
  230. begin
  231.      If (FieldsDD.ItemIndex = 7) or (FieldsDD.ItemIndex = 8) then
  232.         MessageDlg('Cannot Perform Statistical Functions on Text Fields', mtInformation, [mbOK], 0)
  233.      else
  234.         label3.Caption := 'Maximum Value in ' + FieldsDD.Text + ' field is ' +
  235.            FloattoStr(ColumnStatVal(sfMAX, 'DBDEMOS', 'MASTER.DBF', FieldsDD.Text)) ;
  236. end;
  237.  
  238. procedure TForm1.Button12Click(Sender: TObject);
  239. begin
  240.      If (FieldsDD.ItemIndex = 7) or (FieldsDD.ItemIndex = 8) then
  241.         MessageDlg('Cannot Perform Statistical Functions on Text Fields', mtInformation, [mbOK], 0)
  242.      else
  243.         label3.Caption := 'Average Value in ' + FieldsDD.Text + ' field is ' +
  244.            FloattoStr(ColumnStatVal(sfAVG, 'DBDEMOS', 'MASTER.DBF', FieldsDD.Text)) ;
  245. end;
  246.  
  247. procedure TForm1.FormActivate(Sender: TObject);
  248. begin
  249.      Tabley.TableName := 'MASTER.DBF' ;
  250.      Tabley.Open ;
  251.      Tabley.Close ;
  252.      FieldsDD.ItemIndex := 8 ; { Select Risk as default field }
  253.      GroupSumLB.Selected[0] := True ; { Select a field in list }
  254.      ExportTypeDD.ItemIndex := 0 ; { Comma Separated }
  255. end;
  256.  
  257. procedure TForm1.Button13Click(Sender: TObject);
  258. begin
  259.      { View output file }
  260.      ShellExecute(0, NIL, 'C:\EXP2TXT.TXT' + #0, NIL, NIL, 1) ;
  261. end;
  262.  
  263. procedure TForm1.Button8Click(Sender: TObject);
  264. begin
  265.      If CreateFromCSV('DBDEMOS', 'FROMCSV.DB', 'FROMCSV.TXT', False) then
  266.         MessageDlg('Table created OK', mtInformation, [mbOK], 0)
  267.      else
  268.         MessageDlg('Table not created ', mtWarning, [mbOK], 0) ;
  269. end;
  270.  
  271. procedure TForm1.Button14Click(Sender: TObject);
  272. begin
  273.      Close ;
  274. end;
  275.  
  276. end.
  277.